COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 -*-LISP-*-
C00005 00003
C00009 ENDMK
C⊗;
;;; -*-LISP-*-

(HERALD LISTS "")

(EVAL-WHEN (COMPILE) (LOAD "SCM:UMACRO"))

;;; List structure accessors

(ADD-TO-LISP-IMPORTS
 '((CONS CONS UNFORCED-SUBR) (LIST LIST UNFORCED-LSUBR)
   (CONS* LIST* UNFORCED-LSUBR) (LIST* LIST* UNFORCED-LSUBR)))  

(defun-import (set!-car set!-car but-1-forced-subr) (pair new-car)
  (cond ((pairp pair)
	 (rplaca pair new-car))
	(t
	 (sch-error "Invalid pair to SET!-CAR" pair))))

(defun-import (set!-cdr set!-cdr but-1-forced-subr) (pair new-cdr)
  (cond ((pairp pair)
	 (rplacd pair new-cdr))
	(t
	 (sch-error "Invalid pair to SET!-CDR" pair))))

(defun-import (car sch-car) (object)
  (cond ((null object)
	 NIL)
	((pairp object)
	 (car object))
	(t
	 (sch-error "Illegal datum -- CAR" object))))

(defun-import (cdr sch-cdr) (object)
  (cond ((null object)
	 NIL)
	((pairp object)
	 (cdr object))
	(t
	 (sch-error "Illegal datum -- CDR" object))))

(DEFUN-IMPORT (CAAR SCH-CAAR) (OBJECT)
  (SCH-CAR (SCH-CAR OBJECT)))

(DEFUN-IMPORT (CAAAR SCH-CAAAR) (OBJECT)
  (SCH-CAR (SCH-CAR (SCH-CAR OBJECT))))

(DEFUN-IMPORT (CAAAAR SCH-CAAAAR) (OBJECT)
  (SCH-CAR (SCH-CAR (SCH-CAR (SCH-CAR OBJECT)))))

(DEFUN-IMPORT (CADR SCH-CADR) (OBJECT)
  (SCH-CAR (SCH-CDR OBJECT)))

(DEFUN-IMPORT (CAADR SCH-CAADR) (OBJECT)
  (SCH-CAR (SCH-CAR (SCH-CDR OBJECT))))

(DEFUN-IMPORT (CAAADR SCH-CAAADR) (OBJECT)
  (SCH-CAR (SCH-CAR (SCH-CAR (SCH-CDR OBJECT)))))

(DEFUN-IMPORT (CDAR SCH-CDAR) (OBJECT)
  (SCH-CDR (SCH-CAR OBJECT)))

(DEFUN-IMPORT (CADAR SCH-CADAR) (OBJECT)
  (SCH-CAR (SCH-CDR (SCH-CAR OBJECT))))

(DEFUN-IMPORT (CAADAR SCH-CAADAR) (OBJECT)
  (SCH-CAR (SCH-CAR (SCH-CDR (SCH-CAR OBJECT)))))

(DEFUN-IMPORT (CDAAR SCH-CDAAR) (OBJECT)
  (SCH-CDR (SCH-CAR (SCH-CAR OBJECT))))

(DEFUN-IMPORT (CADAAR SCH-CADAAR) (OBJECT)
  (SCH-CAR (SCH-CDR (SCH-CAR (SCH-CAR OBJECT)))))

(DEFUN-IMPORT (CDAAAR SCH-CDAAAR) (OBJECT)
  (SCH-CDR (SCH-CAR (SCH-CAR (SCH-CAR OBJECT)))))

(DEFUN-IMPORT (CDDR SCH-CDDR) (OBJECT)
  (SCH-CDR (SCH-CDR OBJECT)))

(DEFUN-IMPORT (CADDR SCH-CADDR) (OBJECT)
  (SCH-CAR (SCH-CDR (SCH-CDR OBJECT))))

(DEFUN-IMPORT (CAADDR SCH-CAADDR) (OBJECT)
  (SCH-CAR (SCH-CAR (SCH-CDR (SCH-CDR OBJECT)))))

(DEFUN-IMPORT (CDDAR SCH-CDDAR) (OBJECT)
  (SCH-CDR (SCH-CDR (SCH-CAR OBJECT))))

(DEFUN-IMPORT (CADDAR SCH-CADDAR) (OBJECT)
  (SCH-CAR (SCH-CDR (SCH-CDR (SCH-CAR OBJECT)))))

(DEFUN-IMPORT (CDDAAR SCH-CDDAAR) (OBJECT)
  (SCH-CDR (SCH-CDR (SCH-CAR (SCH-CAR OBJECT)))))

(DEFUN-IMPORT (CDADR SCH-CDADR) (OBJECT)
  (SCH-CDR (SCH-CAR (SCH-CDR OBJECT))))

(DEFUN-IMPORT (CADADR SCH-CADADR) (OBJECT)
  (SCH-CAR (SCH-CDR (SCH-CAR (SCH-CDR OBJECT)))))

(DEFUN-IMPORT (CDADAR SCH-CDADAR) (OBJECT)
  (SCH-CDR (SCH-CAR (SCH-CDR (SCH-CAR OBJECT)))))

(DEFUN-IMPORT (CDAADR SCH-CDAADR) (OBJECT)
  (SCH-CDR (SCH-CAR (SCH-CAR (SCH-CDR OBJECT)))))

(DEFUN-IMPORT (CDDDR SCH-CDDDR) (OBJECT)
  (SCH-CDR (SCH-CDR (SCH-CDR OBJECT))))

(DEFUN-IMPORT (CADDDR SCH-CADDDR) (OBJECT)
  (SCH-CAR (SCH-CDR (SCH-CDR (SCH-CDR OBJECT)))))

(DEFUN-IMPORT (CDDDAR SCH-CDDDAR) (OBJECT)
  (SCH-CDR (SCH-CDR (SCH-CDR (SCH-CAR OBJECT)))))

(DEFUN-IMPORT (CDADDR SCH-CDADDR) (OBJECT)
  (SCH-CDR (SCH-CAR (SCH-CDR (SCH-CDR OBJECT)))))

(DEFUN-IMPORT (CDDADR SCH-CDDADR) (OBJECT)
  (SCH-CDR (SCH-CDR (SCH-CAR (SCH-CDR OBJECT)))))

(DEFUN-IMPORT (CDDDDR SCH-CDDDDR) (OBJECT)
  (SCH-CDR (SCH-CDR (SCH-CDR (SCH-CDR OBJECT)))))

(DEFUN-IMPORT (LENGTH SCH-LENGTH) (S-EXP)
  (IF (LISTP S-EXP)
      (DO ((LIST S-EXP (CDR LIST))
           (N 0 (1+ N)))
          ((ATOM? LIST) N))
      (ERROR "argument is not a list --- length" S-EXP)))


(ADD-TO-LISP-IMPORTS
 '(APPEND ASSQ ASSOC MEMQ MEMBER LAST  NTH NTHCDR
   SUBST REVERSE (CONC! NCONC) (DELQ! DELQ) (DELETE! DELETE)
   (EQUAL? EQUAL)))